home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / stat_ac.exe / TEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-01-22  |  3.0 KB  |  101 lines

  1. program TestProg;
  2. { This program is a skeleton test application which demonstrates a modeless status
  3.   dialog as defined in the Status unit. Choosing the single menu item causes a
  4.   modeless status box to be displayed. For five seconds, the contents of the dialog
  5.   are updated showing the amount of elapsed time. Clicking the cancel button or
  6.   otherwise cancelling the box (typing escape or choosing close from the system menu)
  7.   terminates the process before the five seconds have elapsed
  8.  
  9.   Contributed By: Adam Carney 71150,2436}
  10.  
  11.  
  12. {$R TEST.RES}
  13.  
  14. uses WinTypes, WinProcs, OWindows, Strings, Status;
  15.  
  16. const {$I CONST.PAS}
  17.  
  18. type
  19.   TTestApp = object(TApplication)
  20.     procedure  InitMainWindow; virtual;
  21.   end;
  22.  
  23.   PMainWindow = ^TMainWindow;
  24.   TMainWindow = object(TWindow)
  25.     constructor Init(AParent:PWindowsObject; ATitle:PChar);
  26.     procedure CMLengthy(var Msg:TMessage);
  27.       virtual cm_First + cm_Lengthy;
  28.   end;
  29.  
  30. procedure TTestApp.InitMainWindow;
  31. begin
  32.   MainWindow := New(PMainWindow,Init(nil,'Test'));
  33. end;
  34.  
  35. constructor TMainWindow.Init(AParent:PWindowsObject; ATitle:PChar);
  36. begin
  37.   inherited Init(AParent,ATitle);
  38.   Attr.Menu:=LoadMenu(HInstance,PChar(MainMenu));
  39. end;
  40.  
  41. procedure DoSomethingLong(StatDlg:PStatusDlg);
  42. var
  43.   StartCount, TicksElapsed:Longint;
  44.   Tenths,Seconds:word;
  45.   Temp:array[0..2]of char;
  46.   Temp2:array[0..15]of char;
  47. begin
  48.   StartCount:=GetTickCount;
  49.   TicksElapsed:=0; Seconds:=1; Tenths:=1;
  50.   while (TicksElapsed<5000) and StatDlg^.Continue do
  51. { Note: Elapsed time AND state of continue flag in the dialog govern while loop }
  52.     begin
  53.       if TicksElapsed div 1000 <> Seconds then
  54.         begin
  55.           Seconds:=TicksElapsed div 1000;
  56.           Str(Seconds:2,Temp);
  57.           StrCopy(Temp2,'Seconds: ');
  58.           StrCat(Temp2,Temp);
  59.           { Change the 2nd line in the dialog to reflect # of seconds elapsed }
  60.           StatDlg^.Update(id_Stat2,@Temp2);
  61.         end;
  62.       if TicksElapsed div 100 <> Tenths then
  63.         begin
  64.           Tenths:=TicksElapsed div 100;
  65.           Str(Tenths:2,Temp);
  66.           StrCopy(Temp2,'Tenths: ');
  67.           StrCat(Temp2,Temp);
  68.           StatDlg^.Update(id_Stat3,@Temp2);
  69.           { Change the 3rd line in the dialog to reflect # of tenths elapsed }
  70.         end;
  71.       TicksElapsed:=GetTickCount-StartCount;
  72.     end;
  73. end;
  74.  
  75. procedure TMainWindow.CMLengthy(var Msg:TMessage);
  76. var
  77.   Dlg:PStatusDlg;
  78.   i:word;
  79. begin
  80.   { Create new TStatusDlg object }
  81.   Dlg:=New(PStatusDlg,Init(@Self,'Lengthy','Counting...','Operation Cancelled'));
  82.   { Create interface element and display the box on-screen }
  83.   Application^.MakeWindow(Dlg);
  84.   { Call a lenthy procedure; Pass it a pointer to the dialog }
  85.   DoSomethingLong(Dlg);
  86.   { Check state of continue flag and respond accordingly }
  87.   if  Dlg^.Continue then
  88.     Dlg^.Complete('Done: 5 seconds have elapsed');
  89. { else
  90.      the process was cancelled }
  91. end;
  92.  
  93. var
  94.   Test: TTestApp;
  95.  
  96. begin
  97.   Test.Init('Test');
  98.   Test.Run;
  99.   Test.Done;
  100. end.
  101.